home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / split.bas < prev    next >
BASIC Source File  |  1998-12-21  |  9KB  |  225 lines
  1. Attribute VB_Name = "modSplitFile"
  2. Option Explicit
  3. Type FileSection
  4.     Bytes() As Byte
  5.     FileLen As Long
  6. End Type
  7. Type SectionedFile
  8.     Files() As FileSection
  9.     NumberOfFiles As Long
  10. End Type
  11. Type FileInfo
  12.     OrigProjSize As Long
  13.     OrigFileName As String
  14.     FileSectionPath As String
  15.     FileCount As Integer
  16.     FileStartNum As Long
  17. End Type
  18. Type CommReturn
  19.     FileName As String
  20.     Extention As String
  21.     FilePath As String
  22.     Successful As Boolean
  23. End Type
  24. Public Function Save_Load_File(ShowSave As Boolean, ComDlgCnt As CommonDialog, Filter As String, Flags As Long, DialogTitle As String, Optional FilterIndex As Long, Optional DefaultFileName As String = "", Optional InitDir As String) As CommReturn
  25.     On Error Resume Next
  26.     ComDlgCnt.CancelError = True
  27.     ComDlgCnt.FileName = DefaultFileName
  28.     ComDlgCnt.Filter = Filter
  29.     ComDlgCnt.Flags = Flags
  30.     ComDlgCnt.FilterIndex = FilterIndex
  31.     ComDlgCnt.DialogTitle = DialogTitle
  32.     ComDlgCnt.InitDir = InitDir
  33.     If ShowSave Then
  34.         ComDlgCnt.ShowSave
  35.         If Err = cdlCancel Then Exit Function
  36.     Else
  37.         ComDlgCnt.ShowOpen
  38.         If Err = cdlCancel Then Exit Function
  39.     End If
  40.     Save_Load_File.Successful = True
  41.     Save_Load_File.FileName = ReturnFileName(ComDlgCnt.FileName)
  42.     Save_Load_File.Extention = ReturnExtention(ComDlgCnt.FileName, False)
  43.     Save_Load_File.FilePath = FilePath(ComDlgCnt.FileName)
  44. End Function
  45. Public Function ReturnExtention(FileName As String, ReturnFileName As Boolean, Optional SplitVar As String = ".") As String
  46.         Dim m_lngLoop As Long, SelectedLetters As String
  47.         For m_lngLoop = 1 To Len(FileName)
  48.             SelectedLetters = Mid(Right(FileName, m_lngLoop), 1, Len(SplitVar))
  49.             If SelectedLetters = SplitVar Then
  50.         If Not ReturnFileName Then
  51.                     ReturnExtention = Right(FileName, m_lngLoop - 1)
  52.                     Exit Function
  53.         Else
  54.                     ReturnExtention = Left(FileName, Len(FileName) - m_lngLoop)
  55.         End If
  56.             End If
  57.         Next
  58. End Function
  59. Sub SplitDirName(DirName As String, Lines() As String)
  60. 'SplitDirName
  61. 'Created By Allen
  62.     If DirName = "" Then Exit Sub
  63.     Dim Text As String, CurNum As Long, TotalNum As Long, CurPos As Long
  64.     Text = DirName
  65.     CurNum = 1
  66.     CurPos = 1
  67.     TotalNum = GetCount(Text, "\")
  68.     ReDim Lines(1 To TotalNum)
  69.     Do Until CurNum = TotalNum + 1
  70.         Lines(CurNum) = Mid(Text, 1, InStr(CurPos, Text, "\") - 1)
  71.         Text = Mid(Text, Len(Lines(CurNum)) + 2)
  72.         CurNum = CurNum + 1
  73.     Loop
  74. End Sub
  75. Public Function GetCount(Text As String, Search As String)
  76.     Dim CCnt As Long, m_lngLoop As Long
  77.     For m_lngLoop = 1 To Len(Text)
  78.         If Mid(Text, m_lngLoop, Len(Search)) = Search Then
  79.             CCnt = CCnt + 1
  80.         End If
  81.     Next
  82.     GetCount = CCnt
  83. End Function
  84.  
  85. Public Function FilePath(FileName As String) As String
  86.     Dim XText As String, DFileName As String, m_lngLoop As Long, DLines() As String
  87.     XText = FileName
  88.     If Not Right(XText, 1) = "\" Then XText = XText & "\"
  89.     SplitDirName CStr(XText), DLines()
  90.     For m_lngLoop = 1 To UBound(DLines) - 1
  91.         DFileName = DFileName & DLines(m_lngLoop) & "\"
  92.     Next
  93.     FilePath = DFileName
  94. End Function
  95. Public Function SplitFile(SplitFileName As String, _
  96. BeginningNumber As Long, ReturnErrorDes As String, Optional Split As Long = _
  97. 1439865, Optional OutTemplateName As String) As Boolean
  98.     Dim SaveName As String
  99.     SplitFile = True 'Assume Success
  100.     On Error GoTo CleanUp
  101.     Dim CurrentFile As SectionedFile, m_lngNumFil As Long, m_lngLoop As Long, FilesLen As Long
  102.     FilesLen = FileLen(SplitFileName)
  103.     If FilesLen <= Split + 1 Then
  104.     SplitFile = False 'If the File _
  105.     Name is Smaller than the Split Ratio then _
  106.     The Function Doesnt Need Called So it Fails.
  107.     ReturnErrorDes = "File Is Too Small"
  108.     Exit Function
  109.     End If
  110.     Open SplitFileName For Binary As #1 'm_lngLoop Use #1 as _
  111.     Default Because m_lngLoop Normally Only Open one _
  112.     File At a Time. If needed it can be changed.
  113.         If (FilesLen \ Split) >= _
  114.         FilesLen / Split Or (FilesLen \ Split) _
  115.         = FilesLen / Split Then
  116.             m_lngNumFil = (FilesLen _
  117.             \ Split)  ' If VB heightened(or if they _
  118.             were equal) the length of the file _
  119.             divided by the total Split ratio then _
  120.             nothing needs To Do anything.
  121.         ElseIf (FilesLen \ Split) <= _
  122.         FilesLen / Split Then
  123.             m_lngNumFil = (FilesLen \ _
  124.             Split) + 1 ' If VB Lowered The _
  125.             Length Of the File Divided by the Total _
  126.             Split Ratio then it Will Need To Correct _
  127.             it.
  128.         End If
  129.         ReDim CurrentFile.Files(1 To m_lngNumFil)
  130.         For m_lngLoop = 1 To m_lngNumFil - 1
  131.             ReDim CurrentFile.Files(m_lngLoop) _
  132.                 .Bytes(1 To Split) 'Re-Define(Re _
  133.                 Dimention) the Number Of Bytes Per _
  134.                 File
  135.             CurrentFile.Files(m_lngLoop) _
  136.                 .FileLen = UBound(CurrentFile.Files _
  137.                 (m_lngLoop).Bytes) 'Just For Reference
  138.         Next
  139.         For m_lngLoop = 1 To m_lngNumFil
  140.             Get #1, , CurrentFile.Files(m_lngLoop) _
  141.             .Bytes
  142.         Next
  143.         ReDim CurrentFile.Files(m_lngNumFil) _
  144.             .Bytes(1 To FilesLen - ((m_lngNumFil _
  145.             - 1) * Split)) 'ReDefine the Number of _
  146.             bytes for the last file since in many cases _
  147.             it will not be at the Split ratio.
  148.         CurrentFile.NumberOfFiles = m_lngNumFil
  149.         Get #1, , CurrentFile.Files(m_lngNumFil) _
  150.             .Bytes
  151.         CurrentFile.Files(m_lngNumFil) _
  152.             .FileLen = UBound(CurrentFile.Files _
  153.             (m_lngNumFil).Bytes)
  154.     Close #1 'Close File(1)
  155.     For m_lngLoop = 1 To CurrentFile.NumberOfFiles _
  156.     'Save What We Have Done Into Seperate Files
  157.         SaveName = FilePath(OutTemplateName) & ReturnFileName(SplitFileName) & "." & Format(BeginningNumber - 1 + m_lngLoop, _
  158.         "00#")
  159.         Open SaveName For Binary As #1
  160.             Put #1, 1, CurrentFile.Files(m_lngLoop)
  161.         Close #1
  162.     Next
  163.     Dim FileInfoFile As FileInfo
  164.     FileInfoFile.FileCount = m_lngNumFil
  165.     FileInfoFile.OrigFileName = SplitFileName
  166.     FileInfoFile.FileSectionPath = FilePath(SaveName)
  167.     FileInfoFile.OrigProjSize = FileLen(SplitFileName)
  168.     FileInfoFile.FileStartNum = BeginningNumber
  169.     If OutTemplateName = "" Then
  170.     SaveName = SplitFileName & ".tpl"
  171.     Else
  172.     SaveName = OutTemplateName
  173.     End If
  174.     On Error Resume Next
  175.     Open SaveName For Binary As #1
  176.         If Err <> 0 Then ReturnErrorDes = Err.Description _
  177.             : SplitFile = False: Exit Function
  178.         Put #1, , FileInfoFile
  179.     Close #1
  180.     Exit Function
  181. CleanUp:
  182.     ReturnErrorDes = Err.Description
  183.     SplitFile = False
  184. End Function
  185.  
  186. Public Function ReassembleFile(TemplateFileName As String, _
  187.     Optional UseOldFilename As Boolean = True, Optional _
  188.     OutPutName = "C:\Filname.Extention") As Boolean
  189.     Dim FileInfo As FileInfo, OutName As String, File As _
  190.     SectionedFile, m_lngLoop As Long, OpenName
  191.     ReassembleFile = True 'Assume Success
  192.     If Len(TemplateFileName) = 0 Then ReassembleFile = False: Exit Function
  193.     Open TemplateFileName For Binary As #1
  194.         Get #1, , FileInfo 'Get Information on the _
  195.         Previously Saved File(s)
  196.     Close #1
  197.     If UseOldFilename Then
  198.         OutName = FileInfo.OrigFileName
  199.     Else
  200.         OutName = OutPutName
  201.     End If
  202.     ReDim File.Files(1 To FileInfo.FileCount)
  203.     For m_lngLoop = 1 To FileInfo.FileCount
  204.         OpenName = FileInfo.FileSectionPath & ReturnExtention(FileInfo.OrigFileName, False, "\") & "." & _
  205.         Format((FileInfo.FileStartNum - 1 + _
  206.         m_lngLoop), "00#")
  207.         Open OpenName For Binary As #1
  208.             Get #1, 1, File.Files(m_lngLoop)
  209.         Close #1
  210.     Next
  211.     Open OutName For Binary As #1
  212.         For m_lngLoop = 1 To FileInfo.FileCount
  213.             Put #1,